home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / KOPEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-04  |  8.4 KB  |  206 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Open_File --- Open file for use by Kermit protocol routines  *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Open_File( File_Mode : Kermit_File_Modes;
  6.                      FileName  : AnyStr );
  7.  
  8. (*----------------------------------------------------------------------*)
  9. (*                                                                      *)
  10. (*     Procedure:  Open_File                                            *)
  11. (*                                                                      *)
  12. (*     Purpose:    Opens file for use by Kermit routines                *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Open_File( File_Mode : Kermit_File_Modes;                     *)
  17. (*                   FileName  : AnyStr );                              *)
  18. (*                                                                      *)
  19. (*           File_Mode --- whether file is to be opened for read or     *)
  20. (*                         write                                        *)
  21. (*           FileName  --- name of file to open                         *)
  22. (*                                                                      *)
  23. (*     Calls:                                                           *)
  24. (*                                                                      *)
  25. (*        Adjust_Fn                                                     *)
  26. (*        Open_For_Write                                                *)
  27. (*        Int24Result                                                   *)
  28. (*                                                                      *)
  29. (*----------------------------------------------------------------------*)
  30.  
  31. VAR
  32.    Count     : INTEGER;
  33.    Space_Pos : INTEGER;
  34.    Drive     : STRING[1];
  35.    Temp_Fn   : AnyStr;
  36.    FileType  : STRING[3];
  37.    F         : FILE OF BYTE;
  38.    Err       : INTEGER;
  39.    Save_Name : AnyStr;
  40.    IPos      : INTEGER;
  41.  
  42. (*----------------------------------------------------------------------*)
  43. (*                Open_For_Write --- Open file for output               *)
  44. (*----------------------------------------------------------------------*)
  45.  
  46. PROCEDURE Open_For_Write(     FileName : AnyStr;
  47.                           VAR Open_OK  : BOOLEAN  );
  48.  
  49. BEGIN (* Open_For_Write *)
  50.                                    (* Check if file exists *)
  51.  
  52.    ASSIGN( F, FileName );
  53.       (*$I-*)
  54.    RESET( F );
  55.       (*$I+*)
  56.                                    (* Error if file exists *)
  57.    IF Int24Result = 0 THEN
  58.       BEGIN
  59.          Open_OK := FALSE;
  60.             (*$I-*)
  61.          CLOSE( F );
  62.             (*$I+*)
  63.          Err := Int24Result;
  64.       END
  65.    ELSE                            (* Otherwise, new file -- open it *)
  66.       BEGIN
  67.  
  68.          Err := Create_File_Handle( FileName, Attribute_None, XFile_Handle );
  69.  
  70.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  71.             Open_OK := FALSE
  72.          ELSE
  73.             BEGIN (* FileName is new file, open it *)
  74.  
  75.                File_Records := 0.0;
  76.                Open_OK      := TRUE;
  77.                File_Open    := TRUE;
  78.                Buffer_Num   := 0.0;
  79.  
  80.             END;
  81.  
  82.       END;
  83.  
  84. END    (* Open_For_Write *);
  85.  
  86. (*----------------------------------------------------------------------*)
  87.  
  88. BEGIN (* Open_File *)
  89.                                    (* Remember original file name    *)
  90.  
  91.    Save_Name := UpperCase( FileName );
  92.  
  93.                                    (* Select open based upon whether *)
  94.                                    (* file is to be read or written  *)
  95.    CASE File_Mode OF
  96.  
  97.                                    (* Open file for reading *)
  98.       Read_Open : BEGIN
  99.  
  100.                      ASSIGN( F, FileName );
  101.                         (*$I-*)
  102.                      RESET( F );
  103.                         (*$I+*)
  104.  
  105.                      IF ( Int24Result = 0 ) THEN
  106.                         BEGIN
  107.                            Open_OK      := TRUE;
  108.                            File_Open    := TRUE;
  109.                            File_Records := LongFileSize( F );
  110.                            GoToXY( 25 , 4 );
  111.                            WRITE( File_Records : 8 : 0 );
  112.                            ClrEol;
  113.                            Buffer_Num   := 0.0;
  114.                            CLOSE( F );
  115.                            Err := Open_File_Handle( FileName,
  116.                                                     Access_Read_Mode,
  117.                                                     XFile_Handle );
  118.                            Writelne('Sending file ' + FileName , FALSE );
  119.                         END
  120.                      ELSE
  121.                         BEGIN
  122.                            Open_OK := FALSE;
  123.                            GoToXY( 25 , 5 );
  124.                            WRITE('File ', FileName, ' does not exist.');
  125.                            ClrEol;
  126.                         END;
  127.  
  128.                   END;
  129.                                    (* Open file for writing *)
  130.       Write_Open: BEGIN
  131.                                    (* Try opening under provided name *)
  132.  
  133.                      Open_For_Write( FileName, Open_OK );
  134.  
  135.                                    (* If file exists (Open_OK = FALSE), *)
  136.                                    (* then try adjusting name until     *)
  137.                                    (* non-existent name found.          *)
  138.  
  139.                      IF ( NOT Open_OK ) THEN
  140.                         BEGIN
  141.  
  142.                            Temp_Fn := FileName;
  143.  
  144.                            REPEAT
  145.  
  146.                               Adjust_Fn( Temp_Fn, Drive, FileName, FileType );
  147.  
  148.                               IF ( Drive = '!' ) THEN
  149.                                  Temp_Fn := FileName + '.' + FileType
  150.                               ELSE
  151.                                  Temp_Fn := Drive + ':' +
  152.                                             FileName + '.' + FileType;
  153.  
  154.                               Space_Pos := POS( ' ', Temp_Fn );
  155.  
  156.                               IF ( Space_Pos <> 0 ) THEN
  157.                                  BEGIN
  158.                                     DELETE( Temp_Fn, Space_Pos, 1 );
  159.                                     INSERT( '&',     Temp_Fn,   Space_Pos);
  160.                                     WHILE ( POS(' ' , Temp_Fn ) <> 0 ) DO
  161.                                        DELETE( Temp_Fn, POS(' ',Temp_Fn), 1 );
  162.                                     Open_For_Write( Temp_Fn, Open_OK );
  163.                                  END;
  164.  
  165.                            UNTIL ( Open_OK OR ( Space_Pos = 0 ) );
  166.  
  167.                            IF ( NOT Open_OK ) THEN
  168.                               BEGIN
  169.                                  IPos := LENGTH( Temp_Fn );
  170.                                  REPEAT
  171.                                     IF ( Temp_Fn[IPos] <> '&' ) THEN
  172.                                        BEGIN
  173.                                           Temp_Fn[IPos] := '&';
  174.                                           IPos          := 0;
  175.                                        END
  176.                                     ELSE
  177.                                        IPos := IPos - 1;
  178.                                     Open_For_Write( Temp_Fn, Open_OK );
  179.                                  UNTIL ( IPos <= 0 ) OR Open_OK;
  180.                               END;
  181.  
  182.                            GoToXY( 2 , 6 );
  183.  
  184.                            IF Open_OK THEN
  185.                               BEGIN
  186.                                  IF ( Temp_Fn <> Save_Name ) THEN
  187.                                     WRITE('Filename ',Save_Name, ' changed to: ', Temp_Fn)
  188.                                  ELSE
  189.                                     WRITE('Filename: ',Temp_Fn);
  190.                                  Writelne('Receiving file ' + FileName , FALSE );
  191.                               END
  192.                            ELSE
  193.                               WRITE('Filename ', Save_Name, ' could not be opened.');
  194.  
  195.                            ClrEol;
  196.  
  197.                         END  (* NOT Open_OK *)
  198.                      ELSE
  199.                         Writelne('Receiving file ' + FileName , FALSE );
  200.  
  201.                   END    (* Write_Open *);
  202.  
  203.    END (* CASE *);
  204.  
  205. END     (* Open_File *);
  206.